home *** CD-ROM | disk | FTP | other *** search
/ Delphi Informant Complete 1995 - 2000 / Delphi Informant Complete 1995 to 2000.iso / Delphi Informant Magazine Complete Works SOURCE CODE 1995.rar / 1995 / DEC / DI9512DH / mdiedit.pas < prev    next >
Pascal/Delphi Source File  |  1995-08-01  |  9KB  |  347 lines
  1. unit MDIEdit;
  2.  
  3. interface
  4.  
  5. uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Printers,
  6.   Dialogs, Menus, Clipbrd, StdCtrls;
  7.  
  8. type
  9.   TEditForm = class(TForm)
  10.     Memo1: TMemo;
  11.     MainMenu1: TMainMenu;
  12.     MemoPopUp: TPopupMenu;
  13.     FontDialog1: TFontDialog;
  14.     WordWrap1: TMenuItem;
  15.     Left1: TMenuItem;
  16.     Right1: TMenuItem;
  17.     Center1: TMenuItem;
  18.     Cut1: TMenuItem;
  19.     Copy1: TMenuItem;
  20.     Paste1: TMenuItem;
  21.     Delete1: TMenuItem;
  22.     Cut2: TMenuItem;
  23.     Copy2: TMenuItem;
  24.     Paste2: TMenuItem;
  25.     Edit1: TMenuItem;
  26.     SelectAll1: TMenuItem;
  27.     Character1: TMenuItem;
  28.     Font1: TMenuItem;
  29.     File1: TMenuItem;
  30.     New1: TMenuItem;
  31.     Open1: TMenuItem;
  32.     Close1: TMenuItem;
  33.     N1: TMenuItem;
  34.     Save1: TMenuItem;
  35.     SaveAs1: TMenuItem;
  36.     N2: TMenuItem;
  37.     Print1: TMenuItem;
  38.     PrintSetup1: TMenuItem;
  39.     N3: TMenuItem;
  40.     Exit1: TMenuItem;
  41.     PrinterSetupDialog1: TPrinterSetupDialog;
  42.     PrintDialog1: TPrintDialog;
  43.     SaveFileDialog: TSaveDialog;
  44.     MRUSeparator: TMenuItem;
  45.     MRU1: TMenuItem;
  46.     MRU2: TMenuItem;
  47.     MRU3: TMenuItem;
  48.     MRU4: TMenuItem;
  49.     procedure SelectAll(Sender: TObject);
  50.     procedure SetFont(Sender: TObject);
  51.     procedure SetWordWrap(Sender: TObject);
  52.     procedure AlignClick(Sender: TObject);
  53.     procedure CopyToClipboard(Sender: TObject);
  54.     procedure CutToClipboard(Sender: TObject);
  55.     procedure PasteFromClipboard(Sender: TObject);
  56.     procedure Delete(Sender: TObject);
  57.     procedure SetPopUpItems(Sender: TObject);
  58.     procedure SetEditItems(Sender: TObject);
  59.     procedure Open(const AFilename: string);
  60.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  61.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  62.     procedure New1Click(Sender: TObject);
  63.     procedure Open1Click(Sender: TObject);
  64.     procedure Exit1Click(Sender: TObject);
  65.     procedure Close1Click(Sender: TObject);
  66.     procedure Print1Click(Sender: TObject);
  67.     procedure PrintSetup1Click(Sender: TObject);
  68.     procedure SaveAs1Click(Sender: TObject);
  69.     procedure Save1Click(Sender: TObject);
  70.     procedure FormCreate(Sender: TObject);
  71.     procedure FormResize(Sender: TObject);
  72.     procedure MRUClick(Sender: TObject);
  73.     procedure MRUDisplay(Sender:TObject);
  74.   private
  75.     Filename: string;
  76.     procedure UpdateMenus;
  77.     procedure SetEditRect;
  78.  
  79.   end;
  80.  
  81. implementation
  82.  
  83. {$R *.DFM}
  84.  
  85. uses MDIFrame, SysUtils, Messages;
  86.  
  87. const
  88.   BackupExt = '.BAK';
  89.   SWarningText = 'Save Changes to ''%s''?';
  90.   DefaultCaption = 'Untitled';
  91.  
  92. procedure TEditForm.SelectAll(Sender: TObject);
  93. begin
  94.   Memo1.SelectAll;
  95. end;
  96.  
  97. procedure TEditForm.SetFont(Sender: TObject);
  98. begin
  99.   FontDialog1.Font := Memo1.Font;
  100.   if FontDialog1.Execute then
  101.     Memo1.Font := FontDialog1.Font;
  102.   SetEditRect;
  103. end;
  104.  
  105. procedure TEditForm.SetWordWrap(Sender: TObject);
  106. begin
  107.   with Memo1 do
  108.   begin
  109.     WordWrap := not WordWrap;
  110.     if WordWrap then
  111.       ScrollBars := ssVertical else
  112.       ScrollBars := ssBoth;
  113.     WordWrap1.Checked := WordWrap;
  114.   end;
  115.   SetEditRect;
  116. end;
  117.  
  118. procedure TEditForm.AlignClick(Sender: TObject);
  119. begin
  120.   Left1.Checked := False;
  121.   Right1.Checked := False;
  122.   Center1.Checked := False;
  123.   with Sender as TMenuItem do Checked := True;
  124.   with Memo1 do
  125.     if Left1.Checked then
  126.       Alignment := taLeftJustify
  127.     else if Right1.Checked then
  128.       Alignment := taRightJustify
  129.     else if Center1.Checked then
  130.       Alignment := taCenter;
  131. end;
  132.  
  133. procedure TEditForm.CopyToClipboard(Sender: TObject);
  134. begin
  135.   Memo1.CopyToClipboard;
  136. end;
  137.  
  138. procedure TEditForm.CutToClipboard(Sender: TObject);
  139. begin
  140.   Memo1.CutToClipboard;
  141. end;
  142.  
  143. procedure TEditForm.PasteFromClipboard(Sender: TObject);
  144. begin
  145.   Memo1.PasteFromClipboard;
  146. end;
  147.  
  148. procedure TEditForm.Delete(Sender: TObject);
  149. begin
  150.   Memo1.ClearSelection;
  151. end;
  152.  
  153. procedure TEditForm.UpdateMenus;
  154. var
  155.   HasSelection: Boolean;
  156. begin
  157.   Paste1.Enabled := Clipboard.HasFormat(CF_TEXT);
  158.   Paste2.Enabled := Clipboard.HasFormat(CF_TEXT);
  159.   HasSelection := Memo1.SelLength <> 0;
  160.   Cut1.Enabled := HasSelection;
  161.   Copy1.Enabled := HasSelection;
  162.   Delete1.Enabled := HasSelection;
  163.   Cut2.Enabled := HasSelection;
  164.   Copy2.Enabled := HasSelection;
  165. end;
  166.  
  167. procedure TEditForm.SetEditItems(Sender: TObject);
  168. begin
  169.   UpdateMenus;
  170. end;
  171.  
  172. procedure TEditForm.SetPopUpItems(Sender: TObject);
  173. begin
  174.   UpdateMenus;
  175. end;
  176.  
  177. procedure TEditForm.Open(const AFilename: string);
  178. begin
  179.   Filename := AFilename;
  180.   Memo1.Lines.LoadFromFile(FileName);
  181.   Memo1.SelStart := 0;
  182.   Caption := ExtractFileName(FileName);
  183.   Memo1.Modified := False;
  184.  
  185.   FrameForm.MRUUpdate(Self,Filename);  {Update MRUList using saved filename}
  186.  
  187. end;
  188.  
  189. procedure TEditForm.FormClose(Sender: TObject; var Action: TCloseAction);
  190. begin
  191.   Action := caFree;
  192.   FrameForm.MRUDisplay(Sender);       {Update MRU menu display in Frame Form}
  193. end;
  194.  
  195. procedure TEditForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  196. var
  197.   DialogValue: Integer;
  198.   FName: string;
  199. begin
  200.   if Memo1.Modified then
  201.   begin
  202.     FName := Caption;
  203.     DialogValue := MessageDlg(Format(SWarningText, [FName]), mtConfirmation,
  204.       [mbYes, mbNo, mbCancel], 0);
  205.     case DialogValue of
  206.       id_Yes: Save1Click(Self);
  207.       id_Cancel: CanClose := False;
  208.     end;
  209.   end;
  210. end;
  211.  
  212. procedure TEditForm.New1Click(Sender: TObject);
  213. begin
  214.   FrameForm.NewChild(Sender);
  215. end;
  216.  
  217. procedure TEditForm.Open1Click(Sender: TObject);
  218. begin
  219.   FrameForm.OpenChild(Sender);
  220. end;
  221.  
  222. procedure TEditForm.Exit1Click(Sender: TObject);
  223. begin
  224.   FrameForm.Exit1Click(Sender);
  225. end;
  226.  
  227. procedure TEditForm.Close1Click(Sender: TObject);
  228. begin
  229.   Close;
  230. end;
  231.  
  232. { the printing performed in this example either prints the entire buffer,   }
  233. { or...if a section of text is selected, will print the selected text;      }
  234. { in addition, the first line of selected text will be printed left         }
  235. { justified; no attempt is made to make the lines appear as they do on the  }
  236. { monitor.  WYSIWYG printing is beyond the scope of this demo program.      }
  237. { The following features of printing are not demonstrated:                  }
  238. {     Multiple Copies                                                       }
  239. {     Collating Multiple Copies                                             }
  240. {     Page Ranges                                                           }
  241. {     Multiple Fonts, Word Wrapping, etc.                                   }
  242. procedure TEditForm.Print1Click(Sender: TObject);
  243. var
  244.   Line: Integer;
  245.   PrintText: System.Text;
  246. begin
  247.   if PrintDialog1.Execute then
  248.   begin
  249.     AssignPrn(PrintText);
  250.     Rewrite(PrintText);
  251.     Printer.Canvas.Font := Memo1.Font;
  252.     for Line := 0 to Memo1.Lines.Count - 1 do
  253.       Writeln(PrintText, Memo1.Lines[Line]);
  254.     System.Close(PrintText);
  255.   end;
  256. end;
  257.  
  258. procedure TEditForm.PrintSetup1Click(Sender: TObject);
  259. begin
  260.   PrinterSetupDialog1.Execute;
  261. end;
  262.  
  263. procedure TEditForm.SaveAs1Click(Sender: TObject);
  264. begin
  265.   SaveFileDialog.Filename := Filename;
  266.   if SaveFileDialog.Execute then
  267.   begin
  268.     Filename := SaveFileDialog.Filename;
  269.     Caption := ExtractFileName(Filename);
  270.     Save1Click(Sender);
  271.   end;
  272. end;
  273.  
  274. procedure TEditForm.Save1Click(Sender: TObject);
  275.  
  276.   procedure CreateBackup(const Filename: string);
  277.   var
  278.     BackupFilename: string;
  279.   begin
  280.     BackupFilename := ChangeFileExt(Filename, BackupExt);
  281.     DeleteFile(BackupFilename);
  282.     RenameFile(Filename, BackupFilename);
  283.   end;
  284.  
  285.   function IsReadOnly(const Filename: string): Boolean;
  286.   begin
  287.     Result := Boolean(FileGetAttr(Filename) and faReadOnly);
  288.     if Result then MessageDlg(Format('%s is read only.',
  289.       [ExtractFilename(Filename)]), mtWarning, [mbOK], 0);
  290.   end;
  291.  
  292. begin
  293.   if (Filename = '') or IsReadOnly(Filename) then
  294.     SaveAs1Click(Sender)
  295.   else
  296.   begin
  297.     CreateBackup(Filename);
  298.     Memo1.Lines.SaveToFile(Filename);
  299.     Memo1.Modified := False;
  300.  
  301.     FrameForm.MRUUpdate(Sender,Filename);  {Update MRUList using saved filename}
  302.     MRUDisplay(Sender);